home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / miscpas.zip / PLOT3DD.PAS < prev    next >
Pascal/Delphi Source File  |  1984-06-12  |  7KB  |  250 lines
  1. Program ThreeD;
  2.  
  3. {  This program is a modified version of PLOT3D.PAS.  It prompts you }
  4. {  for the rotation amounts before plotting the next iteration.      }
  5.  
  6. {  The program displays and rotates three-dimensional images on      }
  7. {  the IBM PC's graphics display.  The program used three data files }
  8. {  on the default drive.  The data files have the extension '.3D'.   }
  9.  
  10. {  The program uses two External Procedures: Line.inv & Cls.inv.     }
  11. {  These procedures must be on the default drive when compiling.     }
  12.  
  13. {  Author - Jay Mallin                                               }
  14. {           PC Tech Journal, May 1984, pp. 44-48.                    }
  15. {           Typed & Translated into Pascal by Jeff Firestone.        }
  16.  
  17.  
  18. Type
  19.   Strng = String[200];
  20.  
  21. Var
  22.   Nam : Strng;
  23.   f : text;
  24.   exit : boolean;
  25.   i, j, Length, LineCount, pnt, pta, ptb, temp1, temp2 : integer;
  26.  
  27.   max, xmax, ymax, zmax, xmin, ymin, zmin : real;
  28.   Center, Xcenter, Ycenter, Zcenter : Real;
  29.   factor, temp, rcnt : real;
  30.  
  31.   Rot : Array [0..2, 0..2] of real;
  32.   Lines : Array [0..149, 0..1] of integer;
  33.   XYZ : Array [0..149, 0..2] of real;
  34.   XY : Array [0..149, 0..1] of integer;
  35.  
  36.  
  37. Procedure Line(x1,y1,x2,y2,color:integer);
  38.           External 'line.inv';
  39.  
  40. Procedure Cls; External 'Cls.inv';
  41.  
  42.  
  43. Procedure InitPrgm;  { Initialize the arrays & global variables }
  44. Begin
  45.   FillChar(Rot, SizeOf(Rot), 0);
  46.   FillChar(Lines, SizeOf(Lines), 0);
  47.   FillChar(XYZ, SizeOf(XYZ), 0);
  48.   FillChar(XY, SizeOf(XY), 0);
  49.   max:= 0; Center:= 0; Rcnt:= 0;
  50.   ClrScr;
  51. end;
  52.  
  53.  
  54. { Array XYZ contains the three coordinates for each data point, and  }
  55. { Array XY contains the x, y coordinates for drawing on the display. }
  56.  
  57. Procedure ReadFile;  { Read in the data from the '.3D' file }
  58. begin
  59.   assign(f, 'diamond.3d');
  60.   reset(f);
  61.   readln(f, length);
  62.   for i:= 0 to length-1 do
  63.     read(f, xyz[i,0], xyz[i,1], xyz[i,2]);
  64.  
  65. { Now get the pairs of points to connect with lines and store in the   }
  66. { array LINES.                                                         }
  67.  
  68.   LineCount:= -1;
  69.   while (LineCount < 149) and not(EOF(f)) do
  70.   begin
  71.     LineCount:= LineCount + 1;
  72.     read(f, temp1, temp2);
  73.     Lines[LineCount, 0]:= Temp1-1;
  74.     Lines[LineCount, 1]:= Temp2-1;
  75.   end;
  76. end;
  77.  
  78.  
  79. { The figure is centered, then proportioned to fit on the screen.      }
  80. { The first step is to find the largest and smallest value of x,y & z. }
  81.  
  82. Procedure SetupVars;  { Initialize our Variables }
  83. begin
  84.   xmax:= xyz[0,0]; ymax:= xyz[0,1]; zmax:= xyz[0,2];
  85.   xmin:= xmax;     ymin:= ymax;     zmin:= zmax;
  86.   for i:= 1 to length do
  87.   begin
  88.     if xyz[i,0] > xmax then xmax:= xyz[i,0];
  89.     if xyz[i,1] > ymax then ymax:= xyz[i,1];
  90.     if xyz[i,2] > zmax then zmax:= xyz[i,2];
  91.     if xyz[i,0] < xmin then xmin:= xyz[i,0];
  92.     if xyz[i,1] < ymin then ymin:= xyz[i,1];
  93.     if xyz[i,2] < zmin then zmin:= xyz[i,2];
  94.   end;
  95.  
  96. { A center is found between the greatest and smallest values for each   }
  97. { of the three axis, and all the coordinate values are adjusted to move }
  98. { those centers to be at the center.                                    }
  99.  
  100.   Xcenter:= (xmax + xmin) / 2;
  101.   Ycenter:= (ymax + ymin) / 2;
  102.   Zcenter:= 1+(zmax + zmin) / 2;
  103.   for i:= 0 to length do
  104.   begin
  105.     xyz[i,0]:= xyz[i,0] - Xcenter;
  106.     xyz[i,1]:= xyz[i,1] - Ycenter;
  107.     xyz[i,2]:= xyz[i,2] - Zcenter;
  108.   end;
  109.  
  110. { The largest value of all the newly adjusted coordinates is found, }
  111. { and that is used to scale the picture to stay within the screen.  }
  112.  
  113.   max:= Xmax - Xcenter;
  114.   if max < Ymax - Ycenter then max:= Ymax - Ycenter;
  115.   if max < Zmax - Zcenter then max:= Zmax - Zcenter;
  116.   Factor:= 90 / Max;
  117.   for i:= 0 to length do
  118.   begin
  119.     xyz[i,0]:= factor * xyz[i,0];
  120.     xyz[i,1]:= factor * xyz[i,1];
  121.     xyz[i,2]:= factor * xyz[i,2];
  122.   end;
  123. end;
  124.  
  125.  
  126. { Now we begin the section of Procedure which are run each time we }
  127. { wish to rotate the object in XYZ.                                }
  128.  
  129. Procedure DrawIt;
  130.  
  131. { First build the 2D data based upon the 3D data.                  }
  132.  
  133. begin
  134.   for pnt:= 0 to length do
  135.   begin
  136.     xy[pnt, 1]:= round(91 - (5*xyz[pnt,2]/12));
  137.     xy[pnt, 0]:= round(320 + xyz[pnt, 1]);
  138.   end;
  139.  
  140. { Clear the old screen and draw the 2D data by connecting the points. }
  141.  
  142.   cls;
  143.   for i:= 0 to LineCount do
  144.   begin
  145.     pta:= Lines[i,0];
  146.     ptb:= Lines[i,1];
  147.     Line(xy[pta,0],xy[pta,1],xy[ptb,0],xy[ptb,1],1);
  148.   end;
  149. end;
  150.  
  151.  
  152. { This procedure is not currently being used. }
  153. Procedure GetCoords;
  154.     begin
  155.       gotoXY(1,24);
  156.       writeln('Enter next rotation in degrees for each axis, or enter 361 to exit.');
  157.       Line(0,199,620,199,1);
  158.       gotoXY(1,25);
  159.       write('X: '); read(rot[0,0]);
  160.       if rot[0,0] = 361 then exit:= true;
  161.       gotoXY(14,25);
  162.       write('Y: '); read(rot[1,0]);
  163.       if rot[1,0] = 361 then exit:= true;
  164.       gotoXY(27,25);
  165.       write('Z: '); read(rot[2,0]);
  166.       if rot[2,0] = 361 then exit:= true;
  167.     end;  {Procedure GetCoords}
  168.  
  169.  
  170. { Convert the coordinates and rotates them about the x, y & Z axis. }
  171.  
  172. Procedure CalcCoords;
  173.     begin
  174.  
  175. { Convert the input to degrees; find SIN and COS of each.  All the }
  176. { results are stored in Rot.                                       }
  177.  
  178.       for i:= 0 to 2 do
  179.       begin
  180.         rot[i,0]:= pi*(round(rot[i,0]) mod 360)/180;
  181.         rot[i,1]:= sin(rot[i,0]);
  182.         rot[i,2]:= cos(rot[i,0]);
  183.       end;
  184.  
  185. { Compute the new coordinates in XYZ to rotate around the Z axis.  }
  186.  
  187.       if rot[2,2] <> 1 then
  188.         for pnt:= 0 to length do
  189.         begin
  190.           temp:= xyz[pnt,0];
  191.           xyz[pnt,0]:= (rot[2,2] * xyz[pnt,0]) - (rot[2,1] * xyz[pnt,1]);
  192.           xyz[pnt,1]:= (rot[2,1] * temp) + (rot[2,2] * xyz[pnt,1]);
  193.         end;
  194.  
  195. { Rotate around the Y axis if the rotation is not 0. }
  196.  
  197.       if rot[1,2] <> 1 then
  198.         for pnt:= 0 to length do
  199.         begin
  200.           temp:= xyz[pnt,0];
  201.           xyz[pnt,0]:= (temp * rot[1,2]) + (xyz[pnt,2] * rot[1,1]);
  202.           xyz[pnt,2]:= (xyz[pnt,2] * rot[1,2]) - (temp * rot[1,1]);
  203.         end;
  204.  
  205. { Rotate around the X axis. }
  206.  
  207.       if rot[0,2] <> 1 then
  208.          for pnt:= 0 to length do
  209.          begin
  210.            temp:= xyz[pnt,1];
  211.            xyz[pnt,1]:= (temp * rot[0,2]) - (xyz[pnt,2] * rot[0,1]);
  212.            xyz[pnt,2]:= (temp * rot[0,1]) + (xyz[pnt,2] * rot[0,2]);
  213.          end;
  214.     end; {Procedure CalcCoords}
  215.  
  216.  
  217. { Here we caculate the stepping of the rotation.  This sends the figure  }
  218. { spinning in space.                                                     }
  219.  
  220. Procedure ProcessCoords;
  221. begin
  222.   exit:= false;
  223.   while not(exit) do
  224.   begin
  225.     calccoords;
  226.     DrawIt;
  227.     GetCoords;
  228.     {rot[0,0]:= rot[0,0]+4;  { X axis rotation }
  229.     {rot[1,0]:= rot[1,0]+7;  { Y axis rotation }
  230.     {rot[2,0]:= rot[2,0]+3;  { Z axis rotation }
  231.     {rcnt:=rcnt+1;if rcnt>20 then exit:= true;}
  232.  
  233.     {for i:= 0 to length do
  234.     begin
  235.       xyz[i,0]:= 0.97 * xyz[i,0];
  236.       xyz[i,1]:= 0.97 * xyz[i,1];
  237.       xyz[i,2]:= 0.97 * xyz[i,2];
  238.     end;}
  239.   end; {while not(exit)}
  240. end; {Procedure ProcessCoords}
  241.  
  242.  
  243. begin
  244.   InitPrgm;
  245.   ReadFile;
  246.   SetupVars;
  247.   HiRes;  HiResColor(7);
  248.   ProcessCoords;
  249.   TextMode;
  250. end.